home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / pascal / action.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-09  |  10KB  |  336 lines
  1. {$I WCDEFINE.INC}
  2. unit Action;
  3.  
  4. interface
  5.  
  6. uses
  7.   Dos,  TpDos,  TpCrt,  TpString,  TpDate,  Filer,  ApTimer,  Desq,
  8.   WcScreen,  WcEdit,  ChatType,  NameFunc,  Func,  Flags,  WcGlobal,
  9.   WcType;
  10.  
  11.  
  12. type
  13.   ActionWordType = (awNone, awDefault, awChannel);
  14.  
  15.  
  16.   function ReadKeywords(const Filename : String) : Boolean;
  17.   function ReadChannelKeywords(const Filename : String) : Boolean;
  18.   function GetActionWord(const Filename : String; Position : LongInt; var ActionRec : TActionRecord) : Boolean;
  19.   function FindKeyword(const Keyword : String; var Position : LongInt) : ActionWordType;
  20.   function ActionString(const InStr,
  21.                               ToUser, FromUser : String;
  22.                               ToSex, FromSex : TSex;
  23.                               Response : ResponseType) : String;
  24.   procedure DisplayActionArrays;
  25.  
  26. {************************************************************************}
  27.  
  28. implementation
  29.  
  30. {************************************************************************}
  31.   Function GetLangVersion(const findme : String) : String;
  32.   Begin
  33.      If (LangInfo.Language = '') then
  34.        GetLangVersion := MwConfig.LanguagePath+FindMe
  35.      Else
  36.        If ExistFile(MwConfig.LanguagePath+LangInfo.Language+'\'+FindMe) then
  37.          GetLangVersion := MwConfig.LanguagePath+LangInfo.Language+'\'+FindMe
  38.        Else
  39.          If ExistFile(MwConfig.LanguagePath+FindMe) then
  40.            GetLangVersion := MwConfig.LanguagePath+FindMe
  41.          Else
  42.            GetLangVersion := '';
  43.   End;
  44.  
  45.  
  46. {************************************************************************}
  47.  
  48.   function ReadChannelKeywords(const Filename : String) : Boolean;
  49.  
  50.   begin
  51.     if FileName <> '' then
  52.       begin
  53.         ChannelCnt := 0;
  54.         FillChar(ChannelKeys, SizeOf(ChannelKeys), 0);
  55.         ReadChannelKeywords := ReadKeywords(Filename);
  56.       end
  57.     else
  58.       begin
  59.         ChannelCnt := 0;
  60.         ReadChannelKeywords := True;
  61.       end;
  62.   end;
  63.  
  64. {************************************************************************}
  65.  
  66.   function ReadKeywords(const Filename : String) : Boolean;
  67.   var
  68.     Status   : Boolean;
  69.     Finished : Boolean;
  70.     fp       : File;
  71.     ActionRec: TActionRecord;
  72.     p        : LongInt;
  73.     Cnt      : Word;
  74.     Path     : PathStr;
  75.   begin
  76.     Status := False;
  77.     if Filename <> '' then
  78.       begin
  79.         Path := GetLangVersion(ForceExtension(Filename, 'ACT'));
  80.         if ExistFile(Path) then
  81.           begin
  82.             ClearIoError;
  83.             Assign(fp, Path);
  84.             FileMode := $42;
  85.             Reset(fp, 1);
  86.             if NOT IsError then
  87.               begin
  88.                 Finished := False;
  89.                 Cnt := 1;
  90.  
  91.                 while (NOT Finished) AND (NOT Eof(fp)) AND (Cnt <= 200) do
  92.                   begin
  93.                     p := FilePos(fp);
  94.                     BlockRead(fp, ActionRec, SizeOf(TActionRecord));
  95.                     if NOT IsError then
  96.                       begin
  97.                         ChannelKeys[Cnt].Keyword := ActionRec.Keyword;
  98.                         ChannelKeys[Cnt].Position:= Cnt;
  99.                         Inc(Cnt);
  100.                       end
  101.                     else
  102.                       Finished := True;
  103.                   end;
  104.  
  105.                 Status := True;
  106.                 ActionWords := True;
  107.                 ChannelCnt := Cnt;
  108.                 Close(fp);
  109.               end;
  110.           end
  111.         else
  112.           Status := True;
  113.       end
  114.     else
  115.       Status := True;
  116.  
  117.     ReadKeywords := Status;
  118.   end;
  119.  
  120. {************************************************************************}
  121.  
  122.   function GetActionWord(const Filename : String; Position : LongInt; var ActionRec : TActionRecord) : Boolean;
  123.   var
  124.     fp      : File;
  125.     Status  : Boolean;
  126.     OffSet  : LongInt;
  127.     Path    : PathStr;
  128.  
  129.   begin
  130.     Status := False;
  131.  
  132.     if ActionWords then
  133.       begin
  134.         Path := GetLangVersion(ForceExtension(Filename, 'ACT'));
  135.         If Path <> '' then
  136.            Begin
  137.               Assign(fp, Path);
  138.               FileMode := $42;
  139.               Reset(fp, 1);
  140.               if NOT IsError then
  141.                 begin
  142.                   OffSet := (Position - LongInt(1)) * LongInt(SizeOf(TActionRecord));
  143.                   Seek(fp, OffSet);
  144.                   BlockRead(fp, ActionRec, SizeOf(TActionRecord));
  145.                   if NOT IsError then
  146.                     Status := True;
  147.                   Close(fp);
  148.                 end;
  149.            End;
  150.       end
  151.     else
  152.       Status := True;
  153.  
  154.     GetActionWord := Status;
  155.   end;
  156.  
  157. {************************************************************************}
  158.  
  159.   function FindKeyword(const Keyword : String; var Position : LongInt) : ActionWordType;
  160.   var
  161.     Status  : ActionWordType;
  162.     Mid     : Integer;
  163.     Upper   : Integer;
  164.     Lower   : Integer;
  165.  
  166.   begin
  167.     Status  := awNone;
  168.  
  169.     if ActionWords then
  170.       begin
  171.         Position := 0;
  172.  
  173.         if ChannelCnt > 0 then
  174.           begin
  175.             Upper := ChannelCnt;
  176.             Lower := 1;
  177.  
  178.             while (Upper >= Lower) AND (Position = 0) do
  179.               begin
  180.                 Mid := (Lower + Upper) div 2;
  181.                 case CompString(Keyword, ChannelKeys[Mid].Keyword) of
  182.                     Equal  : Position := ChannelKeys[Mid].Position;
  183.                     Less   : Upper := Mid - 1;
  184.                     Greater: Lower := Mid + 1;
  185.                   end;
  186.               end;
  187.  
  188.             if Position <> 0 then
  189.               Status := awChannel;
  190.           end;
  191.       end;
  192.  
  193.     FindKeyword := Status;
  194.   end;
  195.  
  196. {************************************************************************}
  197.  
  198.   function ActionString(const InStr,
  199.                               ToUser, FromUser : String;
  200.                               ToSex, FromSex : TSex;
  201.                               Response : ResponseType) : String;
  202.   var
  203.     p     : Byte;
  204.     OutStr: String;
  205.   const
  206.     AtTo         = '@TO@';
  207.     AtFrom       = '@FROM@';
  208.     AtToHeShe    = '@THE/SHE@';
  209.     AtFromHeShe  = '@FHE/SHE@';
  210.     AtToHisHer   = '@THIS/HER@';
  211.     AtFromHisHer = '@FHIS/HER@';
  212.     AtToHimHer   = '@THIM/HER@';
  213.     AtFromHimHer = '@FHIM/HER@';
  214.   begin
  215.     OutStr := InStr;
  216.     While Pos(AtTO, OutStr) > 0 do
  217.       begin
  218.         p := Pos(AtTO, OutStr);
  219.         Delete(OutStr, p, 4);
  220.         case Response of
  221.           awNormal: Insert(ToUser, OutStr, p);
  222.           awAll   : Insert('everybody', OutStr, p);
  223.           awYou   : Insert('you', OutStr, p);
  224.         end;
  225.       end;
  226.  
  227.     While Pos(AtFROM, OutStr) > 0 do
  228.       begin
  229.         p := Pos(AtFROM, OutStr);
  230.         Delete(OutStr, p, 6);
  231.         Insert(FromUser, OutStr, p);
  232.       end;
  233.  
  234.     While Pos(AtToHeShe, OutStr) > 0 do
  235.       begin
  236.         p := Pos(AtToHeShe, OutStr);
  237.         Delete(OutStr, p, 9);
  238.         Case ToSex of
  239.           sMale     : Insert('he', OutStr, p);
  240.           sFemale   : Insert('she', OutStr, p);
  241.           else        Insert('they', OutStr, p);
  242.         end;
  243.       end;
  244.  
  245.     While Pos(AtFromHeShe, OutStr) > 0 do
  246.       begin
  247.         p := Pos(AtFromHeShe, OutStr);
  248.         Delete(OutStr, p, 9);
  249.         Case FromSex of
  250.           sMale     : Insert('he', OutStr, p);
  251.           sFemale   : Insert('she', OutStr, p);
  252.           else        Insert('they', OutStr, p);
  253.         end;
  254.       end;
  255.  
  256.     While Pos(AtToHisHer, OutStr) > 0 do
  257.       begin
  258.         p := Pos(AtToHisHer, OutStr);
  259.         Delete(OutStr, p, 10);
  260.         Case ToSex of
  261.           sMale     : Insert('his', OutStr, p);
  262.           sFemale   : Insert('her', OutStr, p);
  263.           else        Insert('their', OutStr, p);
  264.         end;
  265.       end;
  266.  
  267.     While Pos(AtFromHisHer, OutStr) > 0 do
  268.       begin
  269.         p := Pos(AtFromHisHer, OutStr);
  270.         Delete(OutStr, p, 10);
  271.         Case FromSex of
  272.           sMale     : Insert('his', OutStr, p);
  273.           sFemale   : Insert('her', OutStr, p);
  274.           else        Insert('their', OutStr, p);
  275.         end;
  276.       end;
  277.  
  278.     While Pos(AtToHimHer, OutStr) > 0 do
  279.       begin
  280.         p := Pos(AtToHimHer, OutStr);
  281.         Delete(OutStr, p, 10);
  282.         Case ToSex of
  283.           sMale     : Insert('him', OutStr, p);
  284.           sFemale   : Insert('her', OutStr, p);
  285.           else        Insert('them', OutStr, p);
  286.         end;
  287.       end;
  288.  
  289.     While Pos(AtFromHimHer, OutStr) > 0 do
  290.       begin
  291.         p := Pos(AtFromHimHer, OutStr);
  292.         Delete(OutStr, p, 10);
  293.         Case FromSex of
  294.           sMale     : Insert('him', OutStr, p);
  295.           sFemale   : Insert('her', OutStr, p);
  296.           else        Insert('them', OutStr, p);
  297.         end;
  298.       end;
  299.  
  300.     ActionString := OutStr;
  301.   end;
  302.  
  303. {************************************************************************}
  304.  
  305.   procedure DisplayActionArrays;
  306.   var
  307.     Str   : String;
  308.     Cnt   : Word;
  309.     ColCnt: Byte;
  310.   begin
  311.     if ChannelCnt > 0 then
  312.       begin
  313.         Str := '';
  314.         ColCnt := 1;
  315.         Cnt := 1;
  316.         while Cnt <= ChannelCnt do
  317.           begin
  318.             Str := Str + Pad(Trim(ChannelKeys[Cnt].Keyword), 12);
  319.             Inc(Cnt);
  320.             Inc(ColCnt);
  321.             if ColCnt > 6 then
  322.               begin
  323.                 Writeln(Str);
  324.                 Str := '';
  325.                 ColCnt := 1;
  326.               end;
  327.           end;
  328.         if Str <> '' then
  329.           Writeln(Str);
  330.       end;
  331.   end;
  332.  
  333. {************************************************************************}
  334.  
  335. end.
  336.